home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / yerk / mps231ss.hqx / Mops source / Toolbox classes / serial < prev    next >
Text File  |  1993-02-01  |  4KB  |  118 lines
  1. \ serial - async serial driver support
  2. \  2/04/85  cbd Version 1
  3. \  9/04/86  cdn Eliminated redundant readnw: & writenw
  4. \  9/06/86  cdn Added bi-directional port usage
  5. \                Automatically send reset: in open:
  6. \  4/19/89    rfl    added break:
  7. \  6/13/89    rfl requires interval for pause
  8. \  3/14/90    rfl    added buffer:
  9. \  8/16/90    rfl    added baudrate: and XON:
  10.  
  11. \ NOTE:  not yet converted to Mops!!***********************
  12.  
  13. Decimal
  14.  
  15. \ define serial i/o port object
  16. :CLASS Port  <Super PBDrvr
  17.  
  18.     Int        thePort        \  0=modem, 1=printer
  19.     Int        Direction    \  0=input, 1=output, 2=both
  20.     Int        Config        \ bits, parity, speed
  21.     Int        inRef        \ input IORefNum
  22.     Int        outRef        \ output IORefNum
  23.  
  24.     \ ( port# direction -- )
  25.     :M  INIT:  put: direction  put: thePort   ;M
  26.  
  27.     \ ( config -- )  set the config word directly
  28.     :M  SETCONFIG:  put: config   ;M
  29.  
  30.     \ ( stop data parity -- )  set stop, data bits in the config word
  31.     \ stop can be 1 or 2
  32.     \ data can be 7 or 8
  33.     \ parity: 0=none 1=odd 2=even
  34.     :M  CONFIG:  { stop data parity -- }      data 7 =
  35.         IF $ 400  ELSE $ C00  THEN -> data    stop 1 =
  36.         IF $ 4000 ELSE $ C000 THEN -> stop  parity  0=
  37.         IF $ 2000
  38.         ELSE parity 1 =
  39.             IF    $ 1000
  40.             ELSE  $ 3000
  41.             THEN
  42.         THEN -> parity
  43.         get: config  $ 01FF and  data stop parity + + or
  44.         put: config   ;M
  45.  
  46.     \ set the baud rate for the port - 300,600,1200,2400, etc.
  47.     :M  BAUD: dup 300 =
  48.         IF    80 +
  49.         ELSE  300 /  380 swap / 1-
  50.         THEN  get: config  $ FE00 and  or put: config
  51.     ;M
  52.  
  53.     \ do PBControl call
  54.     :M  CONTROL:
  55.         get: direction  dup 0= swap 2 = or
  56.         IF    get: inRef  put: IORefNum  addr: header fcall PBControl drop THEN
  57.         get: direction
  58.         IF    get: outRef put: IORefNum  addr: header fcall PBControl drop THEN
  59.     ;M
  60.  
  61.     \ set the communication parms from the configuration word
  62.     :M  RESET:   8 put: csCode  get: config  put: csp1  0 put: IOComp
  63.         control: self  ;M
  64.  
  65.     \ ( addr len -- RefNum )
  66.     :M  OPN: name: super open: super drop get: IORefNum  ;M
  67.  
  68.     \ ( -- )  open the read and write drivers for a port
  69.     :M  OPEN:  get: thePort  0=
  70.         IF    get: direction  dup 0= swap 2 = or
  71.             IF  " .AIn"  opn: self put: inRef  THEN
  72.             get: direction
  73.             IF  " .AOut" opn: self put: outRef THEN
  74.         ELSE  get: direction dup 0= swap 2 = or
  75.             IF  " .BIn"  opn: self put: inRef  THEN
  76.             get: direction
  77.             IF  " .BOut" opn: self put: outRef THEN
  78.         THEN get: IOResult
  79.         reset: self
  80.     ;M
  81.  
  82.     \ ( addr len -- fcode )  receive LEN bytes on the serial port
  83.     :M  READ:   0 put: IOComp    get: inRef put: IORefNum    read: super  ;M
  84.  
  85.     \ ( addr len -- fcode )  send LEN bytes on the serial port
  86.     :M  WRITE:  0 put: IOComp    get: outRef put: IORefNum    write: super ;M
  87.  
  88.     \ ( cfa:proc addr len )  receive LEN bytes asynchronously on the port
  89.     :M  READNW:   get: inRef put: IORefNum    readnw: super  ;M
  90.  
  91.     \ ( cfa:proc addr len )  send LEN bytes asynchronously on the port
  92.     :M  WRITENW:  get: outRef put: IORefNum    writenw: super ;M
  93.  
  94.     \ ( -- char )  get a single character from port
  95.     :M  GET:  pad 1 read: self drop pad c@  ;M
  96.  
  97.     \ ( char -- )  send a single char to port
  98.     :M  PUT:  pad c! pad 1 write: self drop  ;M
  99.  
  100.     \ ( bool -- fcode )  turn CTS handshaking on or off via CONTROL call
  101.     :M  CTS:   addr: csp1  10 erase  put: csp1  10 put: csCode  0 put: IOComp
  102.         control: self  get: IOResult
  103.     ;M
  104.  
  105.     :M  XON: ( -- ) 10 put: cscode $ 01001113 addr: csP1 ! control: self ;M
  106.  
  107.     \ sends out a 100 msec break
  108.     :M  BREAK: 12 put: csCode control: self 6 pause 11 put: csCode control: self ;M
  109.  
  110.     \ ( addr len -- ) increase internal buffer size from default of 64 bytes
  111.     :M  BUFFER: addr: IOBuffer w! +base addr: csP1 ! 9 put: cscode
  112.         control: self
  113.     ;M
  114.  
  115.     :M  BAUDRATE: ( n --) 13 put: cscode put: csP1 control: self ;M
  116.  
  117. ;CLASS
  118.